#!./perl
#
# newwais.pl -- WAIS search interface
#
# from wais.pl
#
# Tony Sanders <sanders@bsdi.com>, Nov 1993
#
# Example configuration (in local.conf):
#     map topdir wais.pl &do_wais($top, $path, $query, "database", "title")
#
# this script uses a sneaky feature of Mosaic that interpretes a 
# single text input form with the name 'isindex' (case sensitive) to
# the same as a <ISINDEX>.  On non-mosaic clients, you wind up with an
# additional query
#
# Note that I know even less about perl than the other two people
# who hacked this, so feel free to send hate mail to pjh@netcom.com
# if I did something really bad (or if there is a better way of
# grabbing the filename off the end of a path.
#
#

# parse disc name from ServerName Environt Variable with this script

do './variables.pl';

&get_request;

$oldLIB = $ENV{"LD_LIBRARY_PATH"}; 
$ENV{"LD_LIBRARY_PATH"} = "$oldLIB:/usr/ucblib"; 
 

#require 'ctime.pl';

$waisq = "./waisq";
$waisd = "/tmp/.wais/wais_$disc_name";


$src = "wais_$disc_name";
$title = "Example Data";
#
# file type map based on file extension, since all file types
# come back type URL
#

%filetype = (
'html', 'HTML File', 'ps', 'PostScript  Document',
'htm', 'HTML File', 'eps', 'PostScript  Document',
'txt','Text File', 'home', ''
);
$filetype{home}="Home page on $disc_name";

open(IN,"/tmp/httpd/.products/.bin/real_names.txt") || die "howdy";
     while (<IN>) {
        @tmp = split(/	/,$_);
        $dir = @tmp[0];
        $realname = @tmp[1];
	#print "test $dir   $realname\n";
	$real_name{$dir} = $realname;
     }
close(IN);

#
# code
# 
sub get_request {

    if ($ENV{'REQUEST_METHOD'} eq "POST") {
        read(STDIN, $request, $ENV{'CONTENT_LENGTH'});
    } elsif ($ENV{'REQUEST_METHOD'} eq "GET" ) {
        $request = $ENV{'QUERY_STRING'};
    }

 
    @names = &url_decode(split(/[&=]/, $request));
    %rqpairs = @names;

}

sub url_decode {

#       Decode a URL encoded string or array of strings
#               + -> space
#               %xx -> character xx


    foreach (@_) {
        tr/+/ /;
        s/%(..)/pack("c",hex($1))/ge;
    }
    @_;
}

sub send_index {
    print "Content-type: text/html\n\n";
    
    print "<HEAD>\n<TITLE>Index of ", $title, "</TITLE>\n</HEAD>\n";
    print "<BODY  bgcolor=\"#DDDDDD\">\n<H1>", $title, "</H1>\n";

    print "This is an index of the information on this server. Please\n";
    print "type a query in the search dialog.\n<P>";
    print "You may use compound searches, such as: <CODE>environment AND cgi</CODE>\n";
    print "<ISINDEX>";
}


sub do_wais {
#    local($top, $path, $query, $src, $title) = @_;

 

#    for (@_){s/\\//g};

    local(@query) = $rqpairs{"isindex"};
	
    local($pquery) = join(" ", @query);
    local($nquery) = $pquery;
    $nquery =~ tr/[A-Z]/[a-z]/;
    if (!(($nquery =~ / and /) || ($nquery =~ / or /)))
    {
       $nquery =~ s/ //g;
    }
	$nquery = $request;
#
# grab a wais source if there is one
#

    local($test) = $ENV{'PATH_INFO'};
    if ($test)
    {
	$test =~ s/\///;
        $src = "wais_$disc_name";
        $title = $test;
    }

    close STDERR;
    open(STDERR, ">/dev/null");

    print "Content-type: text/html\n\n";

    $ENV{'HOME'} = "/";
	
    open(WAISQ, "-|") || exec ($waisq, "-c", $waisd, "-m", 100,
                                "-f", "-", "-S", "$src.src", "-g", $nquery);

    print "<HEAD>\n<TITLE>Search of ", "$disc_name $disc_rest", "</TITLE>\n</HEAD>\n";
    print "<img src=\"/.wais/images/goto_home.gif\">\n";
    print "<BODY bgcolor=\"#DDDDDD\">\n<H1> $disc_name $disc_rest Search Results</H1>\n";

    print "<HR><FORM method=\"GET\" action=\"/cgi-bin/brandnewwais.pl/$src\">\n";
    print "<h2>Enter keyword(s):\n";
#    print "<input name=\"isindex\" value=\"@query\" size=30></FORM><HR>\n";
    print "<input name=\"isindex\" value=\"$nquery\" size=30></FORM><HR></h2>\n";
    
    print "Your search found the following documents\n";
    print "items relevant to <B>\`$nquery\':</B><P>\n";
        print "<center>";
        print "<table border=5>";
    print "<DL>\n";
        print "<th> Company Name</th>";
        print "<th> Document Matched</th>";
        print "<th> Document Type</th>";
        print "<tr>\n";


    #local($hits, $score, $headline, $lines, $bytes, $type, $date);
    local($hits, $score, $lines, $bytes, $type, $date);

$hits = -1;
    print "<OL>";
    while (<WAISQ>) {
        /:score\s+(\d+)/ && ($score = $1);
        /:number-of-lines\s+(\d+)/ && ($lines = $1);
        /:number-of-bytes\s+(\d+)/ && ($bytes = $1);
        /:type "(.*)"/ && ($type = $1);
        /:headline "(.*)"/ && ($headline = $1);         # XXX
        /:date "(\d+)"/ && ($date = $1, $hits++, &docdone);
    }
    &display;
    print "</OL>";
    close(WAISQ);
    print "</DL>\n";

    print "</BODY>\n";
}





#
# THis sub was set up to grab the context of the string.
# It needs to be emplemented
#
sub display {
	for ($i = 0; $i <= $length_context - 1; $i++ ) {
	@tmp = split(/,/,@pcontext[$i]);
	$href = @tmp[1];
	$name = @tmp[0];
	$filename = @tmp[4];
	$test = @tmp[5];
	$ext = @tmp[3];
	$ii = $i+1;

        print "<td><A HREF=\"file:///tmp/httpd/.products/$name/$disc_name.frame.html\">";

        #$name =~ s/_/ /g; 

	print "<B><b>$ii. $real_name{$name} </b></a></td>";
	print "<td><A HREF=\"$href\"><B><b>$filename</B></b></A></td>";
        print "<td>&nbsp$filetype{$ext} \n</td>";
	print "<tr>";

	}
	print "</table>";
	print "</center>";
}


sub docdone {

    if ($headline =~ /Search produced no result/) {
        print "<HR>";
        print "<h2>Search produced no result.</h2>";
#        print $headline, "<P>\n<PRE>";
# the following was &'safeopen
#        open(WAISCAT, "$waisd/$src.cat") || die "$src.cat: $!";
#        while (<WAISCAT>) {
#            s#(Catalog for database:)\s+.*#$1 <STRONG>Catalyst Catalog on $disc_name</STRONG>#;
#            s#Headline:\s+(.*)#Headline: <A HREF="$1">$1</A>#;
#            print;
#        }
#        close(WAISCAT);
#        print "\n</PRE>\n";
    } else {
        $docname = $headline;
	$docname =~ s/\.([^.]*)$//;
	$extension= $1;
	$docname =~ s/\/([^\/]*)$//;
	$docname = $1;
	$filename = $docname;
	$docname = $1;
	#$docname = $headline;
       	#$docname =~ s/\/([^\/]*)$//;

        $test = $headline;
        $test =~ s/file:\/\///;
       	$test =~ s/\/([^\/]*)$//;

        if ($headline =~ /products\/.([^\/]*)\/index/) { $extension = "home"; }

	while ($test =~ /.products/) {
	$filler = $docname;
       	$test =~ s/\/([^\/]*)$//;
	$docname = $1;
	}
	$docname = $filler;
	@context = ($docname,$headline,$filetype,$extension,$filename);
	@pcontext[$hits] = join (",", @context); 
	
    }
    $length_context = @pcontext;
	
    $score = $headline = $lines = $bytes = $type = $date = '';
}

eval '&do_wais';
